home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / tcqbsnip.zip / DIR.BAS < prev    next >
BASIC Source File  |  1997-06-20  |  2KB  |  82 lines
  1. ' DIR.BAS
  2. ' based on a program by Joe Negron
  3. ' Modified by Tika Carr to show color directory listings
  4. '
  5. ' Donated to the public domain
  6. ' No warranties or guarantees are expressed or implied.
  7. '
  8. ' Start QuickBasic with: QB /L QB.QLB
  9. '
  10. 'Function Description:
  11. '
  12. 'This function can be used in one of two ways:
  13. '
  14. '1. Pass the file name as a parameter to check if the file exists. If
  15. '   the file does not exist, then the length of DIR$(FileSpec$) will be
  16. '   zero (0).
  17. '
  18. '2. Pass a path such as C:\WINDOWS\*.* to get a directory listing,
  19. '   including the list of directories.
  20. '-----------------------------------------------------------------------
  21.  
  22. DECLARE FUNCTION DIR$ (FileSpec$)
  23. '$INCLUDE: 'QB.BI'
  24.  
  25. 'Variables needed
  26. DIM SHARED InRegs AS RegType, OutRegs AS RegType
  27. DIM SHARED DTA AS STRING * 44
  28. DIM SHARED FileSpec$
  29. CONST DOS = &H21
  30. CONST SetDTA = &H1A00
  31. CONST FindFirst = &H4E00, FindNext = &H4F00
  32.  
  33. CLS
  34.  
  35. '** Find a file
  36. IF LEN("C:\AUTOEXEC.BAT") = 0 THEN
  37.     PRINT "C:\AUTOEXEC.BAT Not Found"
  38. ELSE
  39.     PRINT "Found C:\AUTOEXEC.BAT"
  40. END IF
  41. PRINT : PRINT
  42. '** Get a listing of a directory:
  43. '    Files are in Yellow, Directories are in Lt. Green
  44. FileSpec$ = "C:\*.*"
  45. Found$ = DIR$(FileSpec$)
  46. DO WHILE LEN(Found$)
  47.     COLOR 7
  48.     IF ASC(MID$(DTA, 22, 1)) = 32 THEN COLOR 14     'Files
  49.     IF ASC(MID$(DTA, 22, 1)) = 16 THEN COLOR 10     'Directories
  50.     PRINT Found$,
  51.     Found$ = DIR$("")
  52. LOOP
  53. COLOR 7
  54.  
  55. FUNCTION DIR$ (FileSpec$) STATIC
  56. Null$ = CHR$(0)
  57.  
  58. InRegs.ax = SetDTA
  59. InRegs.dx = VARPTR(DTA)
  60. Interrupt DOS, InRegs, OutRegs
  61.  
  62. IF LEN(FileSpec$) THEN
  63. FileSpecZ$ = FileSpec$ + Null$
  64.  
  65. InRegs.ax = FindFirst
  66. InRegs.cx = &H30
  67. InRegs.dx = SADD(FileSpecZ$)
  68. ELSE
  69. InRegs.ax = FindNext
  70. END IF
  71.  
  72. Interrupt DOS, InRegs, OutRegs
  73.  
  74. IF OutRegs.flags AND 1 THEN
  75. DIR$ = ""
  76. ELSE
  77. Null = INSTR(31, DTA, Null$)
  78. DIR$ = MID$(DTA, 31, Null - 30)
  79. END IF
  80. END FUNCTION
  81.  
  82.